unit Base64Real;

interface

uses
  Classes;

function MimeEncodeString(const s: AnsiString): AnsiString; stdcall;
function MimeEncodeStringNoCRLF(const s: AnsiString): AnsiString; stdcall;
function MimeDecodeString(const s: AnsiString): AnsiString; stdcall;
procedure MimeEncodeStream(const InputStream: TStream; const OutputStream: TStream); stdcall;
procedure MimeEncodeStreamNoCRLF(const InputStream: TStream; const OutputStream: TStream); stdcall;
procedure MimeDecodeStream(const InputStream: TStream; const OutputStream: TStream); stdcall;
function MimeEncodedSize(const I: Cardinal): Cardinal; stdcall;
function MimeEncodedSizeNoCRLF(const I: Cardinal): Cardinal; stdcall;
function MimeDecodedSize(const I: Cardinal): Cardinal; stdcall;
procedure DecodeHttpBasicAuthentication(const BasicCredentials: AnsiString; out UserId, PassWord: AnsiString); stdcall;
procedure MimeEncode(const InputBuffer; const InputByteCount: Cardinal; out OutputBuffer); stdcall;
procedure MimeEncodeNoCRLF(const InputBuffer; const InputByteCount: Cardinal; out OutputBuffer); stdcall;
procedure MimeEncodeFullLines(const InputBuffer; const InputByteCount: Cardinal; out OutputBuffer); stdcall;
function MimeDecode(const InputBuffer; const InputBytesCount: Cardinal; out OutputBuffer): Cardinal; stdcall;
function MimeDecodePartial(const InputBuffer; const InputBytesCount: Cardinal; out OutputBuffer; var ByteBuffer: Cardinal; var ByteBufferSpace: Cardinal): Cardinal; stdcall;
function MimeDecodePartialEnd(out OutputBuffer; const ByteBuffer: Cardinal; const ByteBufferSpace: Cardinal): Cardinal; stdcall;
procedure Base64Encode(InputFile, OutputFile: string); stdcall;
procedure Base64Decode(InputFile, OutputFile: string); stdcall;

implementation

const
  MIME_ENCODED_LINE_BREAK = 76;
  MIME_DECODED_LINE_BREAK = MIME_ENCODED_LINE_BREAK div 4 * 3;
  BUFFER_SIZE = MIME_DECODED_LINE_BREAK * 3 * 4 * 16;
  MIME_ENCODE_TABLE: array[0..63] of Byte = (
    065, 066, 067, 068, 069, 070, 071, 072,
    073, 074, 075, 076, 077, 078, 079, 080,
    081, 082, 083, 084, 085, 086, 087, 088,
    089, 090, 097, 098, 099, 100, 101, 102,
    103, 104, 105, 106, 107, 108, 109, 110,
    111, 112, 113, 114, 115, 116, 117, 118,
    119, 120, 121, 122, 048, 049, 050, 051,
    052, 053, 054, 055, 056, 057, 043, 047);
  MIME_PAD_CHAR = Byte('=');
  MIME_DECODE_TABLE: array[Byte] of Cardinal = (
    255, 255, 255, 255, 255, 255, 255, 255,
    255, 255, 255, 255, 255, 255, 255, 255,
    255, 255, 255, 255, 255, 255, 255, 255,
    255, 255, 255, 255, 255, 255, 255, 255,
    255, 255, 255, 255, 255, 255, 255, 255,
    255, 255, 255, 062, 255, 255, 255, 063,
    052, 053, 054, 055, 056, 057, 058, 059,
    060, 061, 255, 255, 255, 255, 255, 255,
    255, 000, 001, 002, 003, 004, 005, 006,
    007, 008, 009, 010, 011, 012, 013, 014,
    015, 016, 017, 018, 019, 020, 021, 022,
    023, 024, 025, 255, 255, 255, 255, 255,
    255, 026, 027, 028, 029, 030, 031, 032,
    033, 034, 035, 036, 037, 038, 039, 040,
    041, 042, 043, 044, 045, 046, 047, 048,
    049, 050, 051, 255, 255, 255, 255, 255,
    255, 255, 255, 255, 255, 255, 255, 255,
    255, 255, 255, 255, 255, 255, 255, 255,
    255, 255, 255, 255, 255, 255, 255, 255,
    255, 255, 255, 255, 255, 255, 255, 255,
    255, 255, 255, 255, 255, 255, 255, 255,
    255, 255, 255, 255, 255, 255, 255, 255,
    255, 255, 255, 255, 255, 255, 255, 255,
    255, 255, 255, 255, 255, 255, 255, 255,
    255, 255, 255, 255, 255, 255, 255, 255,
    255, 255, 255, 255, 255, 255, 255, 255,
    255, 255, 255, 255, 255, 255, 255, 255,
    255, 255, 255, 255, 255, 255, 255, 255,
    255, 255, 255, 255, 255, 255, 255, 255,
    255, 255, 255, 255, 255, 255, 255, 255,
    255, 255, 255, 255, 255, 255, 255, 255,
    255, 255, 255, 255, 255, 255, 255, 255);
type
  PByte4 = ^TByte4;
  TByte4 = packed record
    b1: Byte;
    b2: Byte;
    b3: Byte;
    b4: Byte;
  end;
  PByte3 = ^TByte3;
  TByte3 = packed record
    b1: Byte;
    b2: Byte;
    b3: Byte;
  end;

function MimeEncodeString(const s: AnsiString): AnsiString; stdcall;
var
  l: Cardinal;
begin
  if pointer(s) <> nil then
  begin
    l := Cardinal(pointer(Cardinal(s) - 4)^);
    SetLength(result, MimeEncodedSize(l));
    MimeEncode(pointer(s)^, l, pointer(result)^);
  end
  else
    result := '';
end;

function MimeEncodeStringNoCRLF(const s: AnsiString): AnsiString; stdcall;
var
  l: Cardinal;
begin
  if pointer(s) <> nil then
  begin
    l := Cardinal(pointer(Cardinal(s) - 4)^);
    SetLength(result, MimeEncodedSizeNoCRLF(l));
    MimeEncodeNoCRLF(pointer(s)^, l, pointer(result)^);
  end
  else
    result := '';
end;

function MimeDecodeString(const s: AnsiString): AnsiString; stdcall;
var
  ByteBuffer, ByteBufferSpace: Cardinal;
  l: Cardinal;
begin
  if pointer(s) <> nil then
  begin
    l := Cardinal(pointer(Cardinal(s) - 4)^);
    SetLength(result, (l + 3) div 4 * 3);
    ByteBuffer := 0;
    ByteBufferSpace := 4;
    l := MimeDecodePartial(pointer(s)^, l, pointer(result)^, ByteBuffer, ByteBufferSpace);
    Inc(l, MimeDecodePartialEnd(pointer(Cardinal(result) + l)^,
      ByteBuffer, ByteBufferSpace));
    SetLength(result, l);
  end
  else
    result := '';
end;

procedure MimeEncodeStream(const InputStream: TStream; const OutputStream: TStream); stdcall;
var
  InputBuffer: array[0..BUFFER_SIZE - 1] of Byte;
  OutputBuffer: array[0..(BUFFER_SIZE + 2) div 3 * 4 + BUFFER_SIZE div
  MIME_DECODED_LINE_BREAK * 2 - 1] of Byte;
  BytesRead: Cardinal;
  IDelta, ODelta: Cardinal;
begin
  BytesRead := InputStream.Read(InputBuffer, SizeOf(InputBuffer));
  while BytesRead = SizeOf(InputBuffer) do
  begin
    MimeEncodeFullLines(InputBuffer, SizeOf(InputBuffer), OutputBuffer);
    OutputStream.Write(OutputBuffer, SizeOf(OutputBuffer));
    BytesRead := InputStream.Read(InputBuffer, SizeOf(InputBuffer));
  end;
  MimeEncodeFullLines(InputBuffer, BytesRead, OutputBuffer);
  IDelta := BytesRead div MIME_DECODED_LINE_BREAK;
  ODelta := IDelta * (MIME_ENCODED_LINE_BREAK + 2);
  IDelta := IDelta * MIME_DECODED_LINE_BREAK;
  MimeEncodeNoCRLF(pointer(Cardinal(@InputBuffer) + IDelta)^, BytesRead - IDelta, pointer(Cardinal(@OutputBuffer) + ODelta)^);
  OutputStream.Write(OutputBuffer, MimeEncodedSize(BytesRead));
end;

procedure MimeEncodeStreamNoCRLF(const InputStream: TStream; const OutputStream: TStream); stdcall;
var
  InputBuffer: array[0..BUFFER_SIZE - 1] of Byte;
  OutputBuffer: array[0..((BUFFER_SIZE + 2) div 3) * 4 - 1] of Byte;
  BytesRead: Cardinal;
begin
  BytesRead := InputStream.Read(InputBuffer, SizeOf(InputBuffer));
  while BytesRead = SizeOf(InputBuffer) do
  begin
    MimeEncodeNoCRLF(InputBuffer, SizeOf(InputBuffer), OutputBuffer);
    OutputStream.Write(OutputBuffer, SizeOf(OutputBuffer));
    BytesRead := InputStream.Read(InputBuffer, SizeOf(InputBuffer));
  end;
  MimeEncodeNoCRLF(InputBuffer, BytesRead, OutputBuffer);
  OutputStream.Write(OutputBuffer, (BytesRead + 2) div 3 * 4);
end;

procedure MimeDecodeStream(const InputStream: TStream; const OutputStream: TStream); stdcall;
var
  ByteBuffer, ByteBufferSpace: Cardinal;
  InputBuffer: array[0..BUFFER_SIZE - 1] of Byte;
  OutputBuffer: array[0..(BUFFER_SIZE + 3) div 4 * 3 - 1] of Byte;
  BytesRead: Cardinal;
begin
  ByteBuffer := 0;
  ByteBufferSpace := 4;
  BytesRead := InputStream.Read(InputBuffer, SizeOf(InputBuffer));
  while BytesRead > 0 do
  begin
    OutputStream.Write(OutputBuffer, MimeDecodePartial(InputBuffer, BytesRead,
      OutputBuffer, ByteBuffer, ByteBufferSpace));
    BytesRead := InputStream.Read(InputBuffer, SizeOf(InputBuffer));
  end;
  OutputStream.Write(OutputBuffer, MimeDecodePartialEnd(OutputBuffer, ByteBuffer,
    ByteBufferSpace));
end;

procedure DecodeHttpBasicAuthentication(const BasicCredentials: AnsiString; out UserId, PassWord: AnsiString); stdcall;
label
  Fail;
const
  LBasic = 6; { Length ('Basic ') }
var
  DecodedPtr, p: PAnsiChar;
  I, l: Cardinal;
begin
  p := pointer(BasicCredentials);
  if p = nil then goto Fail;
  l := Cardinal(pointer(p - 4)^);
  if l <= LBasic then goto Fail;
  Dec(l, LBasic);
  Inc(p, LBasic);
  GetMem(DecodedPtr, (l + 3) div 4 * 3 { MimeDecodedSize (l) });
  l := MimeDecode(p^, l, DecodedPtr^);
 { Look for colon. }
  I := 0;
  p := DecodedPtr;
  while (l > 0) and (p[I] <> ':') do
  begin
    Inc(I);
    Dec(l);
  end;
 { Store UserId and Password. }
  SetString(UserId, DecodedPtr, I);
  if l > 1 then
    SetString(PassWord, DecodedPtr + I + 1, l - 1)
  else
    PassWord := '';
  FreeMem(DecodedPtr);
  Exit;
  Fail:
  UserId := '';
  PassWord := '';
end;

function MimeEncodedSize(const I: Cardinal): Cardinal; stdcall;
begin
  result := (I + 2) div 3 * 4 + (I - 1) div MIME_DECODED_LINE_BREAK * 2;
end;

function MimeEncodedSizeNoCRLF(const I: Cardinal): Cardinal; stdcall;
begin
  result := (I + 2) div 3 * 4;
end;

function MimeDecodedSize(const I: Cardinal): Cardinal; stdcall;
begin
  result := (I + 3) div 4 * 3;
end;

procedure MimeEncode(const InputBuffer; const InputByteCount: Cardinal; out OutputBuffer); stdcall;
var
  IDelta, ODelta: Cardinal;
begin
  MimeEncodeFullLines(InputBuffer, InputByteCount, OutputBuffer);
  IDelta := InputByteCount div MIME_DECODED_LINE_BREAK;
  ODelta := IDelta * (MIME_ENCODED_LINE_BREAK + 2);
  IDelta := IDelta * MIME_DECODED_LINE_BREAK;
  MimeEncodeNoCRLF(pointer(Cardinal(@InputBuffer) + IDelta)^, InputByteCount - IDelta, pointer(Cardinal(@OutputBuffer) + ODelta)^);
end;

procedure MimeEncodeFullLines(const InputBuffer; const InputByteCount: Cardinal; out OutputBuffer); stdcall;
var
  b, OuterLimit: Cardinal;
  InPtr, InnerLimit: ^Byte;
  OutPtr: PByte4;
begin
  if InputByteCount = 0 then Exit;
  InPtr := @InputBuffer;
  OutPtr := @OutputBuffer;
  InnerLimit := InPtr;
  Inc(Cardinal(InnerLimit), MIME_DECODED_LINE_BREAK);
  OuterLimit := Cardinal(InPtr);
  Inc(OuterLimit, InputByteCount);
 { Multiple line loop. }
  while Cardinal(InnerLimit) <= OuterLimit do
  begin
    while InPtr <> InnerLimit do
    begin
      b := InPtr^;
      b := b shl 8;
      Inc(InPtr);
      b := b or InPtr^;
      b := b shl 8;
      Inc(InPtr);
      b := b or InPtr^;
      Inc(InPtr);
      OutPtr^.b4 := MIME_ENCODE_TABLE[b and $3F];
      b := b shr 6;
      OutPtr^.b3 := MIME_ENCODE_TABLE[b and $3F];
      b := b shr 6;
      OutPtr^.b2 := MIME_ENCODE_TABLE[b and $3F];
      b := b shr 6;
      OutPtr^.b1 := MIME_ENCODE_TABLE[b];
      Inc(OutPtr);
    end;
    OutPtr^.b1 := 13;
    OutPtr^.b2 := 10;
    Inc(Cardinal(OutPtr), 2);
    Inc(InnerLimit, MIME_DECODED_LINE_BREAK);
  end;
end;

procedure MimeEncodeNoCRLF(const InputBuffer; const InputByteCount: Cardinal; out OutputBuffer); stdcall;
var
  b, OuterLimit: Cardinal;
  InPtr, InnerLimit: ^Byte;
  OutPtr: PByte4;
begin
  if InputByteCount = 0 then Exit;
  InPtr := @InputBuffer;
  OutPtr := @OutputBuffer;
  OuterLimit := InputByteCount div 3 * 3;
  InnerLimit := @InputBuffer;
  Inc(Cardinal(InnerLimit), OuterLimit);
  while InPtr <> InnerLimit do
  begin
   { Read 3 bytes from InputBuffer. }
    b := InPtr^;
    b := b shl 8;
    Inc(InPtr);
    b := b or InPtr^;
    b := b shl 8;
    Inc(InPtr);
    b := b or InPtr^;
    Inc(InPtr);
    OutPtr^.b4 := MIME_ENCODE_TABLE[b and $3F];
    b := b shr 6;
    OutPtr^.b3 := MIME_ENCODE_TABLE[b and $3F];
    b := b shr 6;
    OutPtr^.b2 := MIME_ENCODE_TABLE[b and $3F];
    b := b shr 6;
    OutPtr^.b1 := MIME_ENCODE_TABLE[b];
    Inc(OutPtr);
  end;
  case InputByteCount - OuterLimit of
    1:
      begin
        b := InPtr^;
        b := b shl 4;
        OutPtr.b2 := MIME_ENCODE_TABLE[b and $3F];
        b := b shr 6;
        OutPtr.b1 := MIME_ENCODE_TABLE[b];
        OutPtr.b3 := MIME_PAD_CHAR;
        OutPtr.b4 := MIME_PAD_CHAR;
      end;
    2:
      begin
        b := InPtr^;
        Inc(InPtr);
        b := b shl 8;
        b := b or InPtr^;
        b := b shl 2;
        OutPtr.b3 := MIME_ENCODE_TABLE[b and $3F];
        b := b shr 6;
        OutPtr.b2 := MIME_ENCODE_TABLE[b and $3F];
        b := b shr 6;
        OutPtr.b1 := MIME_ENCODE_TABLE[b];
        OutPtr.b4 := MIME_PAD_CHAR;
      end;
  end;
end;

function MimeDecode(const InputBuffer; const InputBytesCount: Cardinal; out OutputBuffer): Cardinal; stdcall;
var
  ByteBuffer, ByteBufferSpace: Cardinal;
begin
  ByteBuffer := 0;
  ByteBufferSpace := 4;
  result := MimeDecodePartial(InputBuffer, InputBytesCount,
    OutputBuffer, ByteBuffer, ByteBufferSpace);
  Inc(result, MimeDecodePartialEnd(pointer(Cardinal(@OutputBuffer) + result)^,
    ByteBuffer, ByteBufferSpace));
end;

function MimeDecodePartial(const InputBuffer; const InputBytesCount: Cardinal; out OutputBuffer; var ByteBuffer: Cardinal; var ByteBufferSpace: Cardinal): Cardinal; stdcall;
var
  lByteBuffer, lByteBufferSpace, c: Cardinal;
  InPtr, OuterLimit: ^Byte;
  OutPtr: PByte3;
begin
  if InputBytesCount > 0 then
  begin
    InPtr := @InputBuffer;
    Cardinal(OuterLimit) := Cardinal(InPtr) + InputBytesCount;
    OutPtr := @OutputBuffer;
    lByteBuffer := ByteBuffer;
    lByteBufferSpace := ByteBufferSpace;
    while InPtr <> OuterLimit do
    begin
      c := MIME_DECODE_TABLE[InPtr^];
      Inc(InPtr);
      if c = $FF then Continue;
      lByteBuffer := lByteBuffer shl 6;
      lByteBuffer := lByteBuffer or c;
      Dec(lByteBufferSpace);
      if lByteBufferSpace <> 0 then Continue;
      OutPtr^.b3 := Byte(lByteBuffer);
      lByteBuffer := lByteBuffer shr 8;
      OutPtr^.b2 := Byte(lByteBuffer);
      lByteBuffer := lByteBuffer shr 8;
      OutPtr^.b1 := Byte(lByteBuffer);
      lByteBuffer := 0;
      Inc(OutPtr);
      lByteBufferSpace := 4;
    end;
    ByteBuffer := lByteBuffer;
    ByteBufferSpace := lByteBufferSpace;
    result := Cardinal(OutPtr) - Cardinal(@OutputBuffer);
  end
  else
    result := 0;
end;

function MimeDecodePartialEnd(out OutputBuffer; const ByteBuffer: Cardinal; const ByteBufferSpace: Cardinal): Cardinal; stdcall;
var
  lByteBuffer: Cardinal;
begin
  case ByteBufferSpace of
    1:
      begin
        lByteBuffer := ByteBuffer shr 2;
        PByte3(@OutputBuffer)^.b2 := Byte(lByteBuffer);
        lByteBuffer := lByteBuffer shr 8;
        PByte3(@OutputBuffer)^.b1 := Byte(lByteBuffer);
        result := 2;
      end;
    2:
      begin
        lByteBuffer := ByteBuffer shr 4;
        PByte3(@OutputBuffer)^.b1 := Byte(lByteBuffer);
        result := 1;
      end;
  else
    result := 0;
  end;
end;

procedure Base64Encode(InputFile, OutputFile: string); stdcall;
var
  Ms: TMemoryStream;
  Ss: TStringStream;
  Str: string;
  List: TStringList;
begin
  Ms := TMemoryStream.Create;
  try
    Ms.LoadFromFile(InputFile);
    Ss := TStringStream.Create(Str);
    try
      MimeEncodeStream(Ms, Ss);
      List := TStringList.Create;
      try
        List.Text := Ss.DataString;
        List.SaveToFile(OutputFile);
      finally
        List.Free;
      end;
    finally
      Ss.Free;
    end;
  finally
    Ms.Free;
  end;
end;

procedure Base64Decode(InputFile, OutputFile: string); stdcall;
var
  Ms: TMemoryStream;
  Ss: TStringStream;
  List: TStringList;
begin
  List := TStringList.Create;
  try
    List.LoadFromFile(InputFile);
    Ss := TStringStream.Create(List.Text);
    try
      Ms := TMemoryStream.Create;
      try
        MimeDecodeStream(Ss, Ms);
        Ms.SaveToFile(OutputFile);
      finally
        Ms.Free;
      end;
    finally
      Ss.Free;
    end;
  finally
    List.Free;
  end;
end;
end.
